home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.21 / modtopas / txt / modtopas.mod < prev    next >
Text File  |  1995-04-23  |  10KB  |  400 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    ModToPas.mod
  4.     :Version.    17.2.90
  5.     :Contents.   Modula II nach Turbo Pascal Konverter
  6.     :Author.     Markus Uhlendahl
  7.     :Address.    Vorm Burgtor 16, D-4408 Dülmen
  8.     :Phone.      02594/81540
  9.     :Copyright.  Public Domain
  10.     :Language.   Modula-2
  11.     :Translator. M2Amiga AMSoft V3.3d
  12.  
  13. **********************************************************************)
  14. MODULE ModToPas;
  15.  
  16.  
  17. FROM SYSTEM     IMPORT ADR,ADDRESS;
  18.  
  19. FROM Arts       IMPORT Assert,AllLevelTermProc;
  20.  
  21. FROM Exec       IMPORT AllocMem,MemReqSet,MemReqs,FreeMem;
  22.  
  23. IMPORT Dos;
  24.  
  25. FROM Arguments  IMPORT GetArg,NumArgs;
  26.  
  27. FROM FileSystem IMPORT Lookup,Close,Length,File,Response;
  28.  
  29. FROM Terminal   IMPORT WriteString,WriteLn,Write;
  30.  
  31. IMPORT Str;
  32. (*
  33. FROM InOut IMPORT WriteInt;
  34. *)
  35.  
  36. VAR memory,memory2,mem2 : ADDRESS;
  37.  
  38.  
  39. PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
  40.  
  41.   VAR read : LONGINT;
  42.  
  43.   BEGIN
  44.     read:=Dos.Read (Dos.Input(),ADR(s),HIGH(s)+1);
  45.     s[read-1]:=0C;
  46.   END ReadString;
  47.  
  48.  
  49. PROCEDURE Schreibe (s : ARRAY OF CHAR;VAR mem : ADDRESS);
  50.  
  51.   VAR i : INTEGER;
  52.  
  53.   BEGIN
  54.     i:=0;
  55.     WHILE (i<=HIGH(s)) AND (s[i]#0C) AND (mem<memory2+30000) DO
  56.       IF s[i]=CHAR(10) THEN
  57.         mem^:=CHAR(13);
  58.         INC (mem);
  59.       END;
  60.       mem^:=s[i];
  61.       INC (mem);
  62.       INC (i);
  63.     END;
  64.   END Schreibe;
  65.  
  66.  
  67. PROCEDURE Schreib (c : CHAR;VAR mem : ADDRESS);
  68.  
  69.   BEGIN
  70.     IF c=CHAR(10) THEN
  71.       mem^:=CHAR(13);
  72.       INC (mem);
  73.     END;
  74.     mem^:=c;
  75.     INC (mem);
  76.   END Schreib;
  77.  
  78.  
  79. PROCEDURE FileNamen (VAR FileName,AusgabeFile : ARRAY OF CHAR);
  80.  
  81.   VAR err : BOOLEAN;
  82.  
  83.   BEGIN
  84.     err:=FALSE;
  85.     IF FileName[Str.Length(FileName)-1]#"d" THEN
  86.       err:=TRUE;
  87.     ELSIF FileName[Str.Length(FileName)-2]#"o" THEN
  88.       err:=TRUE;
  89.     ELSIF FileName[Str.Length(FileName)-3]#"m" THEN
  90.       err:=TRUE;
  91.     ELSIF FileName[Str.Length(FileName)-4]#"." THEN
  92.       err:=TRUE;
  93.     END;
  94.     IF err THEN
  95.       Str.CopyPos (FileName,".mod",Str.Length(FileName));
  96.     END;
  97.     Str.Copy (AusgabeFile,FileName);
  98.     Str.CopyPos (AusgabeFile,".pas",Str.Length(FileName)-4);
  99.   END FileNamen;
  100.  
  101.  
  102. PROCEDURE leseFile (    FileName : ARRAY OF CHAR;
  103.                     VAR laenge   : LONGINT;
  104.                     VAR mem      : ADDRESS);
  105.  
  106.   VAR anz,i  : LONGINT;
  107.       file   : File;
  108.       handle : Dos.FileHandlePtr;
  109.  
  110.   BEGIN
  111.     Lookup (file,FileName,1024,FALSE);
  112.     Assert (file.res#notFound,ADR("DATEI NICHT ZU ÖFFNEN"));
  113.     Length (file,laenge);
  114.     Close (file);
  115.     memory:=AllocMem (laenge,MemReqSet{chip});
  116.     Assert (memory#NIL,ADR("NICHT GENUG CHIPMEMORY"));
  117.     mem:=memory;
  118.     handle:=Dos.Open (ADR(FileName),Dos.readOnly);
  119.     anz:=Dos.Read (handle,mem,laenge);
  120.     Assert (anz=laenge,ADR("FEHLER BEIM LESEN"));
  121.     Dos.Close (handle);
  122.   END leseFile;
  123.  
  124.  
  125. PROCEDURE schreibeFile (ausgabe : ARRAY OF CHAR;
  126.                         laenge  : LONGINT;
  127.                         mem     : ADDRESS);
  128.  
  129.   VAR file : File;
  130.       anz  : LONGINT;
  131.  
  132.   BEGIN
  133.     Lookup (file,ausgabe,1024,TRUE);
  134.     Assert (file.res#notFound,ADR("DATEI NICHT ZU SCHREIBEN"));
  135.     anz:=Dos.Write (file.file,mem,laenge);
  136.     Close (file);
  137.     Assert (anz=laenge,ADR("FEHLER BEIM SCHREIBEN?"));
  138.   END schreibeFile;
  139.  
  140.  
  141. PROCEDURE Wortholen (VAR wort : ARRAY OF CHAR;
  142.                      VAR mem  : ADDRESS;
  143.                      VAR ende : LONGCARD);
  144.  
  145.   VAR i : INTEGER;
  146.  
  147.   BEGIN
  148.     i:=0;
  149.     WHILE NOT(((CHAR(mem^)>="a") AND (CHAR(mem^)<="z")) OR
  150.           ((CHAR(mem^)>="A") AND (CHAR(mem^)<="Z")) OR
  151.           ((CHAR(mem^)<="9") AND (CHAR(mem^)>="0"))) AND
  152.           (LONGCARD(mem)<=ende) DO
  153.       Schreib (CHAR(mem^),mem2);
  154.       INC (mem);
  155.     END;
  156.     WHILE ((CHAR(mem^)>="a") AND (CHAR(mem^)<="z")) OR
  157.           ((CHAR(mem^)>="A") AND (CHAR(mem^)<="Z")) OR
  158.           ((CHAR(mem^)<="9") AND (CHAR(mem^)>="0")) DO
  159.       wort[i]:=CHAR(mem^);
  160.       INC (mem);
  161.       INC (i);
  162.     END;
  163.     wort[i]:=0C;
  164.   END Wortholen;
  165.  
  166.  
  167. PROCEDURE bisSemikolon (VAR mem : ADDRESS);
  168.  
  169.   BEGIN
  170.     WHILE CHAR(mem^)#";" DO
  171.       INC (mem);
  172.     END;
  173.     INC (mem,2);
  174.   END bisSemikolon;
  175.  
  176.  
  177. PROCEDURE funktion (akt : ADDRESS) : BOOLEAN;
  178.  
  179.   VAR access : INTEGER;
  180.  
  181.   BEGIN
  182.     access:=0;
  183.     WHILE (CHAR(akt^)#";") DO
  184.       IF (CHAR(akt^)="(") THEN
  185.         INC (access);
  186.       ELSIF (CHAR(akt^)=")") THEN
  187.         DEC (access);
  188.       END;
  189.       IF (access=0) AND (CHAR(akt^)=":") THEN
  190.         RETURN (TRUE);
  191.       END;
  192.       INC (akt);
  193.     END;
  194.     RETURN (FALSE);
  195.   END funktion;
  196.  
  197.  
  198. PROCEDURE ModulaNachPascal (FileName,AusgabeFile : ARRAY OF CHAR);
  199.  
  200.   VAR laenge : LONGINT;
  201.       mem    : ADDRESS;
  202.       wort   : ARRAY[0..80] OF CHAR;
  203.       ende   : LONGCARD;
  204.       stack  : INTEGER;
  205.       hilf   : ADDRESS;
  206.       fstack : INTEGER;
  207.       fkt    : ARRAY[1..10],[1..80] OF CHAR;
  208.       last   : ARRAY[1..50] OF BOOLEAN;
  209.       pstack : INTEGER;
  210.  
  211.  
  212.   BEGIN
  213.     fstack:=0;
  214.     stack:=0;
  215.     pstack:=0;
  216.     leseFile (FileName,laenge,mem);
  217.     ende:=LONGCARD(mem)+LONGCARD(laenge)-1;
  218.     memory2:=AllocMem (30000,MemReqSet{chip});
  219.     Assert (memory2#NIL,ADR("NICHT GENUG CHIPMEMORY"));
  220.     mem2:=memory2;
  221.     WHILE ende>=LONGCARD(mem) DO
  222.       Wortholen (wort,mem,ende);
  223.       IF Str.Compare (wort,"MODULE")=0 THEN
  224.         Schreibe ("PROGRAM",mem2);
  225.       ELSIF Str.Compare (wort,"PROCEDURE")=0 THEN
  226.         INC (pstack);
  227.         last[pstack]:=FALSE;
  228.         IF funktion(mem) THEN
  229.           INC (fstack);
  230.           last[pstack]:=TRUE;
  231.           hilf:=mem+1;
  232.           Wortholen (fkt[fstack],hilf,ende);
  233.           Schreibe ("FUNCTION",mem2);
  234.         ELSE
  235.           Schreibe ("PROCEDURE",mem2);
  236.         END;
  237.       ELSIF Str.Compare (wort,"RETURN")=0 THEN
  238.         Schreibe (fkt[fstack],mem2);
  239.         Schreibe (":=",mem2);
  240.         REPEAT
  241.           Schreib (CHAR(mem^),mem2);
  242.           INC (mem);
  243.         UNTIL (CHAR(mem^)=";");
  244.         Schreibe ("; EXIT;",mem2);
  245.         INC (mem);
  246.       ELSIF Str.Compare (wort,"IMPORT")=0 THEN
  247.         bisSemikolon (mem);
  248.       ELSIF Str.Compare (wort,"FROM")=0 THEN
  249.         bisSemikolon (mem);
  250.       ELSIF Str.Compare (wort,"THEN")=0 THEN
  251.         Schreibe ("THEN BEGIN",mem2);
  252.         INC (stack);
  253.       ELSIF Str.Compare (wort,"ELSIF")=0 THEN
  254.         DEC (stack);
  255.       ELSIF Str.Compare (wort,"DO")=0 THEN
  256.         Schreibe ("DO BEGIN",mem2);
  257.         INC (stack);
  258.       ELSIF Str.Compare (wort,"ELSE")=0 THEN
  259.         Schreibe ("END ELSE BEGIN",mem2);
  260.       ELSIF Str.Compare (wort,"POINTER")=0 THEN
  261.         Wortholen (wort,mem,ende);
  262.         Schreibe ("^",mem2);
  263.         INC (mem);
  264.       ELSIF Str.Compare (wort,"RECORD")=0 THEN
  265.         Schreibe ("RECORD",mem2);
  266.         INC (stack);
  267.       ELSIF Str.Compare (wort,"WriteString")=0 THEN
  268.         Schreibe ("Write",mem2);
  269.         WHILE CHAR(mem^)#";" DO
  270.           IF (CHAR(mem^)=CHAR(34)) THEN
  271.             Schreib ("'",mem2);
  272.           ELSE
  273.             Schreib (CHAR(mem^),mem2);
  274.           END;
  275.           INC (mem);
  276.         END;
  277.       ELSIF Str.Compare (wort,"Write")=0 THEN
  278.         Schreibe ("Write",mem2);
  279.         WHILE CHAR(mem^)#";" DO
  280.           IF (CHAR(mem^)=CHAR(34)) THEN
  281.             Schreib ("'",mem2);
  282.           ELSE
  283.             Schreib (CHAR(mem^),mem2);
  284.           END;
  285.           INC (mem);
  286.         END;
  287.       ELSIF Str.Compare (wort,"WriteInt")=0 THEN
  288.         Schreibe ("Write",mem2);
  289.         WHILE CHAR(mem^)#";" DO
  290.           IF CHAR(mem^)="," THEN
  291.             Schreib (":",mem2);
  292.           ELSE
  293.             Schreib (CHAR(mem^),mem2);
  294.           END;
  295.           INC (mem);
  296.         END;
  297.       ELSIF Str.Compare (wort,"WriteReal")=0 THEN
  298.         Schreibe ("Write",mem2);
  299.         WHILE CHAR(mem^)#";" DO
  300.           IF CHAR(mem^)="," THEN
  301.             Schreib (":",mem2);
  302.           ELSE
  303.             Schreib (CHAR(mem^),mem2);
  304.           END;
  305.           INC (mem);
  306.         END;
  307.       ELSIF Str.Compare (wort,"ReadReal")=0 THEN
  308.         Schreibe ("Read",mem2);
  309.       ELSIF Str.Compare (wort,"ReadInt")=0 THEN
  310.         Schreibe ("Read",mem2);
  311.       ELSIF Str.Compare (wort,"ReadString")=0 THEN
  312.         Schreibe ("Read",mem2);
  313.       ELSIF Str.Compare (wort,"ReadF")=0 THEN
  314.         Schreibe ("Read",mem2);
  315.       ELSIF Str.Compare (wort,"ReadFInt")=0 THEN
  316.         Schreibe ("Read",mem2);
  317.       ELSIF Str.Compare (wort,"ReadFString")=0 THEN
  318.         Schreibe ("Read",mem2);
  319.       ELSIF Str.Compare (wort,"ReadFReal")=0 THEN
  320.         Schreibe ("Read",mem2);
  321.       ELSIF Str.Compare (wort,"WriteF")=0 THEN
  322.         Schreibe ("Write",mem2);
  323.       ELSIF Str.Compare (wort,"WriteFInt")=0 THEN
  324.         Schreibe ("Write",mem2);
  325.       ELSIF Str.Compare (wort,"WriteFString")=0 THEN
  326.         Schreibe ("Write",mem2);
  327.         WHILE CHAR(mem^)#";" DO
  328.           IF (CHAR(mem^)=CHAR(34)) THEN
  329.             Schreib ("´",mem2);
  330.           ELSE
  331.             Schreib (CHAR(mem^),mem2);
  332.           END;
  333.           INC (mem);
  334.         END;
  335.       ELSIF Str.Compare (wort,"WriteFReal")=0 THEN
  336.         Schreibe ("Write",mem2);
  337.       ELSIF Str.Compare (wort,"END")=0 THEN
  338.         Schreibe ("END",mem2);
  339.         IF stack=0 THEN
  340.           INC (mem);
  341.           IF (pstack>0) AND (last[pstack]) THEN
  342.             DEC (fstack);
  343.           END;
  344.           DEC (pstack);
  345.           Wortholen (wort,mem,ende);
  346.         ELSE
  347.           DEC (stack);
  348.         END;
  349.       ELSE
  350.         Schreibe (wort,mem2);
  351.       END;
  352.     END;
  353.     schreibeFile (AusgabeFile,LONGINT(mem2-memory2),memory2);
  354.   END ModulaNachPascal;
  355.  
  356.  
  357. VAR laenge               : LONGINT;
  358.     FileName,AusgabeFile : ARRAY[0..107] OF CHAR;
  359.     hilf,i               : INTEGER;
  360.  
  361.  
  362. PROCEDURE Cleanup;
  363.  
  364.   BEGIN
  365.     IF memory#NIL THEN
  366.       FreeMem (memory,laenge);
  367.     END;
  368.     IF memory2#NIL THEN
  369.       FreeMem (memory2,30000);
  370.     END;
  371.   END Cleanup;
  372.  
  373.  
  374. BEGIN
  375.   memory:=NIL;
  376.   AllLevelTermProc (Cleanup);
  377.   WriteString ("Modula II nach Turbo Pascal Konverter, 9.2.90,");
  378.   WriteString (" ©  Markus Uhlendahl");WriteLn;
  379.   IF NumArgs()>0 THEN
  380.     FOR i:=1 TO NumArgs() DO
  381.       GetArg (i,FileName,hilf);
  382.       IF FileName[0]="?" THEN
  383.         WriteString ("Aufruf: ModToPas {prgname{.mod}}");WriteLn;
  384.         FileName[0]:=0C;
  385.       END;
  386.       IF FileName[0]#0C THEN
  387.         FileNamen (FileName,AusgabeFile);
  388.         ModulaNachPascal (FileName,AusgabeFile);
  389.       END;
  390.     END;
  391.   ELSE
  392.     WriteString ("Bitte Filename:");ReadString (FileName);
  393.     IF FileName[0]#0C THEN
  394.       FileNamen (FileName,AusgabeFile);
  395.       ModulaNachPascal (FileName,AusgabeFile);
  396.     END;
  397.   END;
  398. END ModToPas.
  399.  
  400.